home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / menace / blt.frm (.txt) next >
Encoding:
Visual Basic Form  |  1997-07-10  |  23.2 KB  |  625 lines
  1. VERSION 5.00
  2. Begin VB.Form frmBlt 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "Menace"
  5.    ClientHeight    =   2055
  6.    ClientLeft      =   60
  7.    ClientTop       =   345
  8.    ClientWidth     =   3030
  9.    KeyPreview      =   -1  'True
  10.    LinkTopic       =   "Form1"
  11.    MousePointer    =   99  'Custom
  12.    ScaleHeight     =   2055
  13.    ScaleWidth      =   3030
  14.    StartUpPosition =   2  'CenterScreen
  15.    Visible         =   0   'False
  16.    Begin VB.Timer Timer1 
  17.       Enabled         =   0   'False
  18.       Interval        =   100
  19.       Left            =   1275
  20.       Top             =   1425
  21.    End
  22. Attribute VB_Name = "frmBlt"
  23. Attribute VB_GlobalNameSpace = False
  24. Attribute VB_Creatable = False
  25. Attribute VB_PredeclaredId = True
  26. Attribute VB_Exposed = False
  27. ' Transparent Blit
  28. Option Compare Text
  29. Option Explicit
  30. Dim u As Long
  31. Dim blnend As Boolean
  32. ' Win32
  33. Const IMAGE_BITMAP = 0
  34. Const LR_LOADFROMFILE = &H10
  35. Const LR_CREATEDIBSECTION = &H2000
  36. Const SRCCOPY = &HCC0020
  37. Private Type BITMAP
  38.         bmType          As Long
  39.         bmWidth         As Long
  40.         bmHeight        As Long
  41.         bmWidthBytes    As Long
  42.         bmPlanes        As Integer
  43.         bmBitsPixel     As Integer
  44.         bmBits          As Long
  45. End Type
  46. ' GDI32
  47. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  48. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  49. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  50. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  51. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  52. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  53. ' USER32
  54. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  55. Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
  56. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  57. Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
  58. Const ResolutionX = 640     ' Width for the display mode
  59. Const ResolutionY = 480     ' Height for the display mode
  60. Dim dd As DirectDraw2               ' DirectDraw object
  61. Dim ddsdFront As DDSURFACEDESC      ' Front surface description
  62. Dim ddsFront As DirectDrawSurface2  ' Front buffer
  63. Dim ddsBack As DirectDrawSurface2   ' Back buffer
  64. Dim aDDS As DirectDrawSurface2      ' Images to blit
  65. Dim tDDS As DirectDrawSurface2      ' tiles to blit
  66. Dim ddCaps As DDSCAPS               ' Capabilities for search
  67. Dim fx As DDBLTFX
  68. 'hold the sprites
  69. Dim spnx%(40), spny%(40), spnw%(40), spnh%(40), spnox%(40), spnoy%(40)
  70. Dim mode%      'mode% is the current behaviour
  71. Dim anim%      'amount through the given behaviour animation
  72. Dim animshift% 'flag to indicate if blocks should be pushed during anim
  73. 'dim sprite behaviour guff
  74. Dim bname$(30)  'name of behaviour (arbitrary 30 behaviour limit)
  75. Dim bcells%(30) 'number of cells in the behaviour
  76. Dim bchar%(30, 30) '30 behaviours, with max 30 cells in the anim
  77. Dim bxo%(30, 30)   'x offset
  78. Dim byo%(30, 30)   'y offset
  79. 'now the block array x and y in pixels
  80. Dim blockx%(30)    'up to 30 blocks on a map
  81. Dim blocky%(30)
  82. Dim blockcell%(30)
  83. Dim blockmode%(30) '0=none, 1=left, 2=right, 3=fall
  84. Dim blockcount%    'number of blocks on this level
  85.             
  86. Dim level%
  87. 'hold the map
  88. Dim map(40, 6) As Integer '40 wide, 6 high
  89. Dim mapl%, mapv% 'left margin
  90. ' Loads a bitmap in a DirectDraw surface
  91. Private Function CreateDDSFromBitmap(dd As DirectDraw2, ByVal strFile As String) As DirectDrawSurface2
  92.     Dim hbm As Long                 ' Handle on bitmap
  93.     Dim bm As BITMAP                ' Bitmap header
  94.     Dim ddsd As DDSURFACEDESC       ' Surface description
  95.     Dim dds As DirectDrawSurface2   ' Created surface
  96.     Dim hdcImage As Long            ' Handle on image
  97.     Dim mhdc As Long                ' Handle on surface context
  98.     Dim clr As Long                 'hold the colour top left to be made transparent
  99.     ' Load bitmap
  100.     hbm = LoadImage(ByVal 0&, strFile, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
  101.     ' Get bitmap info
  102.     GetObject hbm, Len(bm), bm
  103.     ' Fill surface description
  104.     With ddsd
  105.         .dwSize = Len(ddsd)
  106.         .dwFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
  107.         .DDSCAPS.dwCaps = DDSCAPS_OFFSCREENPLAIN
  108.         .dwWidth = bm.bmWidth
  109.         .dwHeight = bm.bmHeight
  110.     End With
  111.     ' Create surface
  112.     dd.CreateSurface ddsd, dds, Nothing
  113.     ' Create memory device
  114.     hdcImage = CreateCompatibleDC(ByVal 0&)
  115.     ' Select the bitmap in this memory device
  116.     SelectObject hdcImage, hbm
  117.     ' Restore the surface
  118.     dds.Restore
  119.     ' Get the surface's DC
  120.     dds.GetDC mhdc
  121.     ' Copy from the memory device to the DirectDrawSurface
  122.     StretchBlt mhdc, 0, 0, ddsd.dwWidth, ddsd.dwHeight, hdcImage, 0, 0, bm.bmWidth, bm.bmHeight, SRCCOPY
  123.     'get the top left colour
  124.     clr = GetPixel(mhdc, 0, 0)
  125.     ' Release the surface's DC
  126.     dds.ReleaseDC mhdc
  127.     ' Release the memory device and the bitmap
  128.     DeleteDC hdcImage
  129.     DeleteObject hbm
  130.     'make surface transparent
  131.     Dim mhddck As DDCOLORKEY
  132.     mhddck.dwColorSpaceLowValue = clr 'really works only for 24 bit colour
  133.     mhddck.dwColorSpaceHighValue = clr 'but as sprites have black is all 0 at any rate
  134.     dds.SetColorKey DDCKEY_SRCBLT, mhddck
  135.     ' Returns the new surface
  136.     Set CreateDDSFromBitmap = dds
  137. End Function
  138. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  139. If mode% = 1 Or mode% = 2 Then 'walking left or right
  140.     'shift = 1 then push, = 2 then jump
  141.     Select Case KeyCode
  142.         Case vbKeyR
  143.             'restart  the level
  144.             loadlevel level%
  145.         Case vbKeyControl
  146.             Select Case Shift
  147.             Case 2
  148.                 If mode% = 1 Then mode% = 5 Else mode% = 7 'jump
  149.                 anim% = 0 'amount through the jump
  150.                 animshift% = 0 'don't shift blocks
  151.             Case 3 'jump & shift
  152.                 If mode% = 1 Then mode% = 5 Else mode% = 7 'jump
  153.                 anim% = 0 'amount through the jump
  154.                 animshift% = 1 'shift blocks
  155.             End Select
  156.         Case vbKeyEscape
  157.             blnend = True
  158.         Case vbKeyLeft
  159.             Select Case Shift
  160.             Case 0 'walk normally
  161.                 mode% = 1 'walkleft
  162.                 anim% = anim% + 1 'walk
  163.                 If anim% > 7 Then anim% = 1
  164.                 If map((mapl% + 294) \ 60, mapv% \ 60) = 0 Then
  165.                     mapl% = mapl% - 6
  166.                 End If
  167.                 If mapl% < -300 Then mapl% = -300
  168.                 If mapl% Mod 60 = 0 Then
  169.                     If map((mapl% + 300) \ 60, (mapv% + 10) \ 60) = 0 Then
  170.                         mode% = 3 'fallleft
  171.                     End If
  172.                 End If
  173.             Case 1 'shift box
  174.                 mode% = 9 'shift left
  175.                 anim% = 0 'amount through the jump
  176.                 animshift% = 1 'shift blocks
  177.             End Select
  178.         Case vbKeyRight
  179.             Select Case Shift
  180.             Case 0 'walk normally
  181.                 mode% = 2 'walkright
  182.                 anim% = anim% + 1 'walk
  183.                 If anim% > 7 Then anim% = 1
  184.                 If map((mapl% + 365) \ 60, mapv% \ 60) = 0 Then
  185.                     mapl% = mapl% + 6
  186.                 End If
  187.                 If mapl% > 2400 Then mapl% = 2400
  188.                 If mapl% Mod 60 = 0 Then
  189.                     If map((mapl% + 300) \ 60, (mapv% + 10) \ 60) = 0 Then
  190.                         mode% = 4 'fall
  191.                     End If
  192.                 End If
  193.             Case 1 'shift box
  194.                 mode% = 10 'shift right
  195.                 anim% = 0 'amount through the jump
  196.                 animshift% = 1 'shift blocks
  197.             End Select
  198.     End Select
  199. End If
  200. End Sub
  201. Private Sub Form_Load()
  202.     Dim a%, g$, bi%
  203.     mapv% = 0
  204.     mode% = 3 'fallleft
  205.     anim% = 1 'start of animation
  206.     ShowCursor 0
  207.     ' Create the DirectDraw object
  208.     DirectDrawCreate ByVal 0&, dd, Nothing
  209.     ' This app is full screen and will change the display mode
  210.     dd.SetCooperativeLevel Me.hwnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN
  211.     ' Set the display mode
  212.     dd.SetDisplayMode ResolutionX, ResolutionY, 8, 0, 0
  213.     ' Load images (in a real app don't load the surrounding empty space !)
  214.     Set aDDS = CreateDDSFromBitmap(dd, App.Path & "\menace.BMP")
  215.     Set tDDS = CreateDDSFromBitmap(dd, App.Path & "\tiles.BMP")
  216.     ' Fill front buffer description structure...
  217.     With ddsdFront
  218.         ' Structure size
  219.         .dwSize = Len(ddsdFront)
  220.         ' Use DDSD_CAPS and BackBufferCount
  221.         .dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  222.         ' Primary, flipable surface
  223.         .DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX Or DDSCAPS_SYSTEMMEMORY
  224.         ' One back buffer (you can try 2)
  225.         .dwBackBufferCount = 1
  226.     End With
  227.     ' Create front buffer
  228.     dd.CreateSurface ddsdFront, ddsFront, Nothing
  229.     ' Retrieve the back buffer object
  230.     ddCaps.dwCaps = DDSCAPS_BACKBUFFER
  231.     ddsFront.GetAttachedSurface ddCaps, ddsBack
  232.     'load up the sprites
  233.     Open App.Path & "\menace.spr" For Random As #1 Len = 2
  234.     For a% = 0 To 39
  235.         Get #1, a% * 6 + 1, spnox%(a% + 1)
  236.         Get #1, a% * 6 + 2, spnoy%(a% + 1)
  237.         Get #1, a% * 6 + 3, spnx%(a% + 1)
  238.         Get #1, a% * 6 + 4, spny%(a% + 1)
  239.         Get #1, a% * 6 + 5, spnw%(a% + 1)
  240.         Get #1, a% * 6 + 6, spnh%(a% + 1)
  241.     Next
  242.     Close #1
  243.     'load up sprite behaviours
  244.     Open App.Path & "\spritebe.txt" For Input As #1
  245.     Do
  246.         Line Input #1, g$
  247.         If left$(g$, 1) = "*" Then
  248.             'record follows
  249.             Input #1, bi%
  250.             Input #1, bname$(bi%), bcells%(bi%)
  251.             For a% = 1 To bcells%(bi%)
  252.                 Input #1, bchar%(bi%, a%), bxo%(bi%, a%), byo%(bi%, a%)
  253.             Next
  254.         End If
  255.     Loop Until EOF(1)
  256.     Close #1
  257.     'load the map level
  258.     level% = 1
  259.     loadlevel level%
  260.     Timer1.Enabled = -1
  261. End Sub
  262. ' Draw next frame
  263. Private Sub DrawNextFrame()
  264.     Dim a%, b%, xx%, ofx%, sp%, cbx%, cby%
  265.     Dim t As RECT
  266.     'On Error Resume Next
  267.     ' Clear the back buffer
  268.     With fx
  269.         .dwSize = Len(fx)
  270.         .dwFillColor = RGB(0, 0, 0)
  271.     End With
  272.     t.top = 0
  273.     t.left = 0
  274.     t.bottom = ResolutionY
  275.     t.Right = ResolutionX
  276.     ddsBack.Blt t, Nothing, t, DDBLT_COLORFILL, fx
  277.       
  278.     'draw the map
  279.     ofx% = mapl% \ 60
  280.     For a% = 0 To 11
  281.         If a% + ofx% >= 0 And a% + ofx% <= 39 Then
  282.             For b% = 6 To 1 Step -1
  283.                 drawblock map(a% + ofx%, b% - 1), a% * 60 - (mapl% Mod 60), b% * 60
  284.             Next
  285.         End If
  286.     Next
  287.     'move moveable blocks
  288.     For a% = 1 To 30
  289.         If blockmode%(a%) > 0 Then 'something to do
  290.             'yeah I know, cheap and nasty,
  291.             'moving blocks go on top of the map... oh well
  292.             drawblock blockcell%(a%), (blockx%(a%) - mapl%) - 300, blocky%(a%)
  293.             Select Case blockmode%(a%)
  294.                 Case 1, 2 'left,right
  295.                     If blockmode%(a%) = 1 Then blockx%(a%) = blockx%(a%) - 6 Else blockx%(a%) = blockx%(a%) + 6
  296.                     If blockx%(a%) Mod 60 = 0 Then
  297.                         'now check above old spot!
  298.                         If blockmode%(a%) = 1 Then cbx% = (blockx%(a%) - 235) \ 60 Else cbx% = (blockx%(a%) - 355) \ 60
  299.                         cby% = (blocky%(a%) - 10) \ 60
  300.                         blockmode%(a%) = 3 'fall
  301.                         checkabove cbx%, cby%
  302.                     End If
  303.                 Case 3 'fall till hit something
  304.                     If map((blockx%(a%) - 300) \ 60, (blocky%(a%) + 10) \ 60) = 0 Then
  305.                         'keep falling
  306.                         blocky%(a%) = blocky%(a%) + 10
  307.                     Else
  308.                         'hit ground so add to map
  309.                         map((blockx%(a%) - 300) \ 60, (blocky%(a%) - 5) \ 60) = blockcell%(a%)
  310.                         blockmode%(a%) = 0 'stop falling
  311.                         checkforgroup
  312.                     End If
  313.             End Select
  314.         End If
  315.     Next
  316.     'place the character
  317.     Select Case mode%
  318.         Case 1, 2
  319.         Case 3, 4 'fall
  320.             anim% = anim% + 1
  321.             If anim% > bcells%(mode%) Then anim% = 1
  322.             If map((mapl% + 300) \ 60, (mapv% + 10) \ 60) = 0 And map((mapl% + 355) \ 60, (mapv% + 10) \ 60) = 0 Then
  323.                 mapv% = mapv% + 10
  324.             Else
  325.                 If mode% = 3 Then mode% = 6 Else mode% = 8 'land
  326.             End If
  327.             If mapv% > 350 Then
  328.                 mapv% = 350
  329.                 If mode% = 3 Then mode% = 6 Else mode% = 8 'land
  330.             End If
  331.         Case 5, 7 'jump left or right
  332.             anim% = anim% + 1
  333.             If anim% > bcells%(mode%) Then
  334.                 If mode% = 5 Then mode% = 3 Else mode% = 4
  335.                 anim% = 1
  336.             Else
  337.                 If anim% <= 15 Then 'on the way up
  338.                     If mode% = 5 Then 'left
  339.                         If map((mapl% + 300) \ 60, (mapv% - 60) \ 60) = 0 And map((mapl% + 355) \ 60, (mapv% - 60) \ 60) = 0 Then
  340.                             mapv% = mapv% + byo%(mode%, anim%)
  341.                             If mapv% < 1 Then mapv% = 1
  342.                         Else
  343.                             anim% = 15
  344.                         End If
  345.                         If map((mapl% + 300 + bxo%(mode%, anim%)) \ 60, mapv% \ 60) = 0 And map((mapl% + 300 + bxo%(mode%, anim%)) \ 60, (mapv% - 50) \ 60) = 0 Then
  346.                             mapl% = mapl% + bxo%(mode%, anim%)
  347.                         Else
  348.                             mode% = 3: anim% = 1
  349.                             If animshift% Then startmove 1
  350.                         End If
  351.                     Else 'right
  352.                         If map((mapl% + 355) \ 60, (mapv% - 60) \ 60) = 0 And map((mapl% + 300) \ 60, (mapv% - 60) \ 60) = 0 Then
  353.                             mapv% = mapv% + byo%(mode%, anim%)
  354.                             If mapv% < 1 Then mapv% = 1
  355.                         Else
  356.                             anim% = 15
  357.                         End If
  358.                         If map((mapl% + 355 + bxo%(mode%, anim%)) \ 60, mapv% \ 60) = 0 And map((mapl% + 355 + bxo%(mode%, anim%)) \ 60, (mapv% - 50) \ 60) = 0 Then
  359.                             mapl% = mapl% + bxo%(mode%, anim%)
  360.                             If mapv% < 1 Then mapv% = 1
  361.                         Else
  362.                             mode% = 4: anim% = 1
  363.                             If animshift% Then startmove 2
  364.                         End If
  365.                     End If
  366.                     
  367.                 Else 'on the way down
  368.                     If mode% = 5 Then 'left
  369.                         If map((mapl% + 300) \ 60, (mapv% + 15) \ 60) = 0 And map((mapl% + 355) \ 60, (mapv% + 15) \ 60) = 0 Then
  370.                             mapv% = mapv% + byo%(mode%, anim%)
  371.                             If mapv% < 1 Then mapv% = 1
  372.                         Else
  373.                             mode% = 6: anim% = 1 'land
  374.                         End If
  375.                         If map((mapl% + 300 + bxo%(mode%, anim%)) \ 60, mapv% \ 60) = 0 And map((mapl% + 300 + bxo%(mode%, anim%)) \ 60, (mapv% - 50) \ 60) = 0 Then
  376.                             mapl% = mapl% + bxo%(mode%, anim%)
  377.                         Else
  378.                             mode% = 3: anim% = 1 'fall
  379.                             If animshift% Then startmove 1
  380.                         End If
  381.                     Else 'right
  382.                         If map((mapl% + 355) \ 60, (mapv% + 15) \ 60) = 0 And map((mapl% + 300) \ 60, (mapv% + 15) \ 60) = 0 Then
  383.                             mapv% = mapv% + byo%(mode%, anim%)
  384.                             If mapv% < 1 Then mapv% = 1
  385.                         Else
  386.                             mode% = 4: anim% = 1 'fall
  387.                         End If
  388.                         If map((mapl% + 355 + bxo%(mode%, anim%)) \ 60, mapv% \ 60) = 0 And map((mapl% + 355 + bxo%(mode%, anim%)) \ 60, (mapv% - 50) \ 60) = 0 Then
  389.                             mapl% = mapl% + bxo%(mode%, anim%)
  390.                         Else
  391.                             mode% = 4: anim% = 1 'fall
  392.                             If animshift% Then startmove 2
  393.                         End If
  394.                     End If
  395.                 End If
  396.             End If
  397.         Case 9, 10 'shift blocks
  398.             If anim% = 1 Then 'start pushing
  399.                 'make blocks moveable
  400.                 If mode% = 9 Then startmove 1 Else startmove 2
  401.             End If
  402.             anim% = anim% + 1
  403.             If anim% > bcells%(mode%) Then
  404.                 anim% = 1
  405.                 If mode% = 9 Then mode% = 1 Else mode% = 2
  406.             End If
  407.         Case Else
  408.             anim% = anim% + 1
  409.             If anim% > bcells%(mode%) Then
  410.                 Select Case mode%
  411.                     Case 6: mode% = 1 'land now walk left
  412.                     Case 8: mode% = 2 'land now walk right
  413.                     Case Else: mode% = 1
  414.                 End Select
  415.                 anim% = 1
  416.             End If
  417.     End Select
  418.         
  419.     sp% = bchar%(mode%, anim%)
  420.     If sp% = 0 Then sp% = 1
  421.     t.top = spny%(sp%)
  422.     t.left = spnx%(sp%)
  423.     t.bottom = spny%(sp%) + spnh%(sp%)
  424.     t.Right = spnx%(sp%) + spnw%(sp%)
  425.        
  426.    ddsBack.BltFast 295 + spnox%(sp%), mapv% + spnoy%(sp%) + 10, aDDS, t, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
  427.     'If Err.Number <> 0 Then
  428.         ' Just in case
  429.     '    Stop
  430.     'End If
  431.     ' Flip the buffers
  432.     Do
  433.         ddsFront.Flip Nothing, 0
  434.         If Err.Number = DDERR_SURFACELOST Then ddsFront.Restore
  435.     Loop Until Err.Number = 0
  436.         
  437. End Sub
  438. Private Sub Form_Unload(Cancel As Integer)
  439. End Sub
  440. Private Sub Timer1_Timer()
  441.     Timer1.Enabled = 0
  442.     'Render loop
  443.     While Not blnend
  444.         DrawNextFrame
  445.         u = DoEvents
  446.     Wend
  447.     'clean up
  448.     Set aDDS = Nothing
  449.     Set tDDS = Nothing
  450.     dd.FlipToGDISurface
  451.     dd.RestoreDisplayMode
  452.     dd.SetCooperativeLevel 0, DDSCL_NORMAL
  453.     Set ddsBack = Nothing
  454.     Set ddsFront = Nothing
  455.     Set dd = Nothing
  456.     ShowCursor 1
  457.     Unload frmBlt
  458. End Sub
  459. Sub loadlevel(mapnum%)
  460. Dim a%, b%, nfile%
  461. mapv% = 0
  462. mapl% = 0
  463. mode% = 3
  464. Open App.Path & "\map.dat" For Random As #1 Len = 2
  465. nfile% = LOF(1) / 2
  466. blockcount% = 0
  467. For a% = 0 To 39
  468.     For b% = 0 To 5
  469.         Get #1, 1 + (a% + (b% * 40)) + (mapnum% - 1) * 2500, map(a%, b%)
  470.         If map(a%, b%) > 3 Then blockcount% = blockcount% + 1
  471.     Next
  472. Close #1
  473. For a% = 1 To 30
  474.     blockmode%(a%) = 0
  475. End Sub
  476. Sub drawblock(cl%, ByVal xx%, ByVal yy%)
  477. Dim a%, b%
  478. Dim t As RECT
  479. Select Case cl%
  480.     Case 0
  481.         t.top = -99
  482.     Case 1:
  483.         t.top = 0
  484.         t.left = 0
  485.         t.bottom = 75
  486.         t.Right = 80
  487.     Case 2:
  488.         t.top = 0
  489.         t.left = 80
  490.         t.bottom = 75
  491.         t.Right = 160
  492.     Case 3:
  493.         t.top = 0
  494.         t.left = 160
  495.         t.bottom = 75
  496.         t.Right = 240
  497.     Case 4:
  498.         t.top = 75
  499.         t.left = 0
  500.         t.bottom = 150
  501.         t.Right = 80
  502.     Case 5:
  503.         t.top = 75
  504.         t.left = 80
  505.         t.bottom = 150
  506.         t.Right = 160
  507.     Case 6:
  508.         t.top = 75
  509.         t.left = 160
  510.         t.bottom = 150
  511.         t.Right = 240
  512. End Select
  513. If t.top >= 0 Then
  514.     If xx% < 0 Then
  515.         t.left = t.left + Abs(xx%)
  516.         xx% = 0
  517.     End If
  518.     If xx% > 560 Then
  519.         t.Right = t.Right - (xx% - 560)
  520.     End If
  521.     If t.Right > t.left Then ddsBack.BltFast xx%, yy%, tDDS, t, DDBLTFAST_SRCCOLORKEY Or DDBLTFAST_WAIT
  522. End If
  523. End Sub
  524. Sub startmove(initdir%)
  525. Dim cbx%, cby%, a%
  526. If initdir% = 1 Then cbx% = (mapl% + 290) \ 60 Else cbx% = (mapl% + 369) \ 60
  527. cby% = (mapv% - 30) \ 60
  528. If map(cbx%, cby%) > 3 Then 'moveable block
  529.     If (initdir% = 1 And map%(cbx% - 1, cby%) = 0) Or (initdir% = 2 And map%(cbx% + 1, cby%) = 0) Then
  530.         For a% = 1 To 30
  531.             If blockmode%(a%) = 0 Then 'spare block
  532.                 blockx%(a%) = cbx% * 60 + 300
  533.                 blocky%(a%) = cby% * 60 + 60
  534.                 blockcell%(a%) = map(cbx%, cby%)
  535.                 If initdir% = 1 Then blockmode%(a%) = 1 Else blockmode%(a%) = 2
  536.                 Exit For
  537.             End If
  538.         Next
  539.         map(cbx%, cby%) = 0 'remove block of map, as now is in motion
  540.         'when the block stops, it will be readded to the map
  541.     End If
  542. End If
  543. End Sub
  544. Sub checkforgroup()
  545. Dim a%, b%, cc%, ct%, flag%
  546. For a% = 0 To 39
  547.     ct% = 0: cc% = 0
  548.     For b% = 0 To 5
  549.         If map(a%, b%) > 3 Then
  550.             If map(a%, b%) <> cc% Then ct% = 0
  551.             cc% = map(a%, b%)
  552.             ct% = ct% + 1
  553.             If ct% = 3 Then
  554.                 map(a%, b%) = 0
  555.                 map(a%, b% - 1) = 0
  556.                 map(a%, b% - 2) = 0
  557.                 
  558.                 checkabove a%, b%
  559.                 checkabove a%, b% - 1
  560.                 checkabove a%, b% - 2
  561.                 
  562.                 flag% = True
  563.                 blockcount% = blockcount% - 3
  564.                 If blockcount% < 3 Then
  565.                     level% = level% + 1
  566.                     loadlevel level%
  567.                 End If
  568.                 Exit For
  569.             End If
  570.         Else
  571.             ct% = 0
  572.         End If
  573.     Next
  574. If Not flag% Then
  575.     For b% = 0 To 5
  576.         ct% = 0: cc% = 0
  577.         For a% = 0 To 39
  578.             If map(a%, b%) > 3 Then
  579.                 If map(a%, b%) <> cc% Then ct% = 0
  580.                 cc% = map(a%, b%)
  581.                 ct% = ct% + 1
  582.                 If ct% = 3 Then
  583.                     map(a%, b%) = 0
  584.                     map(a% - 1, b%) = 0
  585.                     map(a% - 2, b%) = 0
  586.                 
  587.                     checkabove a%, b%
  588.                     checkabove a% - 1, b%
  589.                     checkabove a% - 2, b%
  590.                     
  591.                     flag% = True
  592.                     blockcount% = blockcount% - 3
  593.                     If blockcount% < 3 Then
  594.                         level% = level% + 1
  595.                         loadlevel level%
  596.                     End If
  597.                     Exit For
  598.                 End If
  599.             Else
  600.                 ct% = 0
  601.             End If
  602.         Next
  603.     Next
  604. End If
  605. End Sub
  606. Sub checkabove(cbx%, ByVal cby%)
  607. Dim b%
  608. Do While cby% > 0
  609.     cby% = cby% - 1
  610.     If map%(cbx%, cby%) > 3 Then
  611.         For b% = 1 To 30
  612.             If blockmode%(b%) = 0 Then 'spare block
  613.                 blockx%(b%) = cbx% * 60 + 300
  614.                 blocky%(b%) = cby% * 60 + 60
  615.                 blockcell%(b%) = map(cbx%, cby%)
  616.                 map(cbx%, cby%) = 0
  617.                 blockmode%(b%) = 3 'fall
  618.                 Exit For
  619.             End If
  620.         Next
  621.     Else
  622.         Exit Do
  623.     End If
  624. End Sub
  625.